home *** CD-ROM | disk | FTP | other *** search
/ com!online 2005 May / com_0505_1.iso / opensource / top10 / amc_install.exe / {app} / Scripts / FilmPub.ifs < prev    next >
Encoding:
Text File  |  2004-12-12  |  4.6 KB  |  178 lines
  1. // GETINFO SCRIPTING
  2. // Filmpub (CZ) import, made by Marek Pospisil
  3.  
  4. program FilmPub;
  5.  
  6. const
  7.   BASEURL = 'http://filmpub.atlas.cz';
  8.  
  9.   // true ... bude vyplneno, false .. nebude vyplneno
  10.   cOriginalTitle   = true;
  11.   cTranslatedTitle = true;
  12.   cDirector        = false;
  13.   cCountry         = false;
  14.   cYear            = false;
  15.   cLength          = false;
  16.   cActors          = false;
  17.   cURL             = false;
  18.   cDescription     = true;
  19.   cComments        = true;
  20.  
  21. var
  22.   MovieName: string;
  23.   MovieURL: string;
  24.  
  25. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  26. var
  27.   i: Integer;
  28. begin
  29.   result := -1;
  30.   if StartAt < 0 then
  31.     StartAt := 0;
  32.   for i := StartAt to List.Count-1 do
  33.     if Pos(Pattern, List.GetString(i)) <> 0 then
  34.     begin
  35.       result := i;
  36.       Break;
  37.     end;
  38. end;
  39.  
  40. function iPos (Substr: String; S: String): Integer;
  41. begin
  42.   Substr := AnsiLowerCase(Substr);
  43.   S := AnsiLowerCase(S);
  44.   Result := Pos(Substr, S);
  45. end;
  46.  
  47. function FormatText(T: String): String;
  48. var BeginPos: Integer;
  49. begin
  50.   BeginPos := iPos('  ', T);
  51.   while (BeginPos > 0 ) do
  52.   begin
  53.     Delete(T, BeginPos, 1);
  54.     BeginPos := iPos('  ', T);
  55.   end;
  56.  
  57.   T := StringReplace(T, #13#10, '');
  58.   T := StringReplace(T, '</p>', #13#10#13#10);
  59.   T := StringReplace(T, '</P>', #13#10#13#10);
  60.   T := StringReplace(T, '<br>', #13#10);
  61.   T := StringReplace(T, '<BR>', #13#10);
  62.   Result := T;
  63. end;
  64.  
  65. (* ****************************************************************************
  66.  *
  67.  * FilmPub section
  68.  *
  69.  * ****************************************************************************)
  70. procedure AnalyzePageFilmPub(Address: string);
  71. var
  72.   Line, iLine, aLine, MovieTitle, MovieAddress: string;
  73.   BeginPos, EndPos: Integer;
  74. begin
  75.   Line := GetPage(Address);
  76.  
  77.   PickTreeClear;
  78.   PickTreeAdd('NalezenĪ˜ filmy:', '');
  79.  
  80.   BeginPos := iPos('<a href="film.aspx', Line);
  81.  
  82.   while (BeginPos > 0 ) do
  83.   begin
  84.     Line := Copy(Line, BeginPos, Length(Line));
  85.  
  86.     EndPos := iPos('</a>', Line);
  87.     iLine := Copy(Line, 0, EndPos-1);
  88.     Line := Copy(Line, EndPos, Length(Line));
  89.  
  90.     BeginPos := iPos('"', iLine);
  91.     aLine := Copy(iLine, BeginPos+1, Length(iLine));
  92.     EndPos :=  iPos('"', aLine);
  93.     aLine := Copy(iLine, BeginPos+1, EndPos-1);
  94.     MovieAddress := BASEURL + '/' + aLine;
  95.     BeginPos := iPos('>', iLine);
  96.     MovieTitle := Trim(Copy(iLine, BeginPos+1, Length(iLine)));
  97.     PickTreeAdd(MovieTitle, MovieAddress);
  98.  
  99.     BeginPos := iPos('<a href="film.aspx', Line);
  100.   end;
  101.     if PickTreeExec(Address) then
  102.       AnalyzeMoviePageFilmPub(Address);
  103. end;
  104.  
  105.  
  106. procedure AnalyzeMoviePageFilmPub(Address: string);
  107. var
  108.   Line, iLine, aLine, Value, MovieAddress: string;
  109.   BeginPos, EndPos, tPos: Integer;
  110. begin
  111.   Line := GetPage(Address);
  112.   
  113.   BeginPos := iPos('Detail filmu', Line);
  114.   Line := Copy(Line, BeginPos, Length(Line));
  115.   
  116.   BeginPos := iPos('<h1>', Line);
  117.   EndPos := iPos('</h1>', Line);
  118.   iLine := Copy(Line, BeginPos, EndPos-BeginPos);
  119.   EndPos := iPos('<span>', iLine);
  120.   Value := Copy(iLine, 0, EndPos-1);
  121.   HTMLRemoveTags(Value);
  122.   HTMLDecode(Value);
  123.   if cTranslatedTitle then
  124.     SetField(fieldTranslatedTitle, Value);
  125.  
  126.   Value := Copy(iLine, EndPos, Length(iLine));
  127.   HTMLRemoveTags(Value);
  128.   HTMLDecode(Value);
  129.   if cOriginalTitle then
  130.     SetField(fieldOriginalTitle, Value);
  131.  
  132.   BeginPos := iPos('clanek.aspx?articleId=', Line);
  133.   Line := Copy(Line, BeginPos, Length(Line));
  134.   EndPos := iPos('"', Line);
  135.   MovieAddress := Copy(Line, 0, EndPos-1);
  136.  
  137.  
  138.   Line := GetPage(BASEURL + '/' + MovieAddress);
  139.   BeginPos := iPos('<p class="prolog"', Line);
  140.   Line := Copy(Line, BeginPos, Length(Line));
  141.   EndPos := iPos('</p>', Line);
  142.   Value := Copy(Line, 0, EndPos-1);
  143.   Value := FormatText(Value);
  144.   HTMLRemoveTags(Value);
  145.   HTMLDecode(Value);
  146.   if cDescription then
  147.     SetField(fieldDescription, Value);
  148.  
  149.   Line := Copy(Line, EndPos+Length('</p>'), Length(Line));
  150.   EndPos := iPos('</div>', Line);
  151.   Value := Copy(Line, 0, EndPos-1);
  152.  
  153.   Value := FormatText(Value);
  154.   HTMLRemoveTags(Value);
  155.   HTMLDecode(Value);
  156.   if cComments then
  157.     SetField(fieldComments, Value);
  158.  
  159.   DisplayResults;
  160. end;
  161.  
  162.  
  163. begin
  164.   if CheckVersion(3,4,0) then
  165.   begin
  166.     MovieName := GetField(fieldOriginalTitle);
  167.     if MovieName = '' then
  168.       MovieName := GetField(fieldTranslatedTitle);
  169.     if Input('FilmPub Import', 'Enter the title of the movie:', MovieName) then
  170.     begin
  171.       AnalyzePageFilmPub(BASEURL+'/hledej.aspx?findString='+UrlEncode(MovieName));
  172.     end;
  173.   end
  174.   else
  175.     ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.0)');
  176. end.
  177.  
  178.